perm filename SAY.SAI[4,ALS] blob sn#058559 filedate 1973-08-17 generic text, type T, neo UTF8
00010	BEGIN "SAY"
00020	DEFINE ⊂="COMMENT";  ⊂ 7/31/73 Runs SIG from FIX output;
00030	
00040	REQUIRE "SIG" LOAD_MODULE;
00050	REQUIRE "BLOCKS.HDR" SOURCE_FILE;
00060	EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00070	INTEGER ARRAY LFILE[0:'177];
00080	INTERNAL INTEGER ARRAY INDATA[0:4000];
00090	INTERNAL INTEGER H,I,J,K,L,M,N,P,NF;
00100	INTERNAL INTEGER FLAG,CFLAG,RFLAG,UPCNT,TABTOT;
00110	INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,PHW,SMOCNT,SMCNT2,ZCNT;
00120	INTEGER NEW,OLD,SUM,S1,S2,S3,S4,RL;
00130	INTEGER ARRAY N1[0:3];
00140	INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,EOFB,BRK;
00150	INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6;
00160	STRING READ1,FILEL,FILEI,TFILE,TFILEI,FILLST,PREHINT;
00170	DEFINE ARRSIZ="4096";
00180	INTERNAL INTEGER ARRAY LRN[0:ARRSIZ];
00190	INTERNAL INTEGER ARRAY RES,USE[0:TABSIZ];
00200	BOOLEAN ER;
00210	
00220	STRING PROCEDURE HEADER;
00230	  BEGIN "HEADER"
00240	  STRING H1; INTEGER I,J,K;
00250	  IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1;   HINCNT←HINCNT+1;
00260	    RETURN(PREHINT) END   ELSE WHILE HCOUNT=0 DO BEGIN "XX"
00270	  I←LFILE[HINDEX];  K←LDB(POINT(12,I,23)); J←SEGC-K; 
00280	  IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←999; RETURN(PREHINT) END;
00290	  IF J ≥ 0 THEN BEGIN "LATCH"
00300	   H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
00310	   IF H1≠0 THEN BEGIN
00320	     PREHINT←H1; HCOUNT←LDB(POINT(12,I,35));
00330	     HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1; 
00340	     RETURN(PREHINT); DONE  END
00350	     ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(12,I,35));
00360	     HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
00370	  END "LATCH";
00380	 PREHINT←"NU"; RETURN(PREHINT); END "XX";
00390	END "HEADER";
00400	
00410	PROCEDURE SMOOTH;
00420	BEGIN "SMOOTH"
00430	
00440	INTEGER ARRAY X,D[0:3];
00450	INTEGER P,Q;
00460	
00470	X[0]←K LSH -(N1[1]+N1[2]+N1[3]);
00480	X[1]←(K LSH -(N1[2]+N1[3])) LAND ('377 LSH (N1[1]-8));
00490	X[2]←(K LSH -N1[3]) LAND ('377 LSH (N1[2]-8));
00500	X[3]←K LAND ('377 LSH (N1[3]-8));
00510	
00520	D[0]←1 LSH (N1[1]+N1[2]+N1[3]);
00530	D[1]←1 LSH (N1[2]+N1[3]);
00540	D[2]←1 LSH N1[3]; ⊂ Not used if N1[2]=0;
00550	D[3]←1; ⊂ Not used and having no meaning if N1[3]=0;
00560	
00570	FOR P←0 STEP 1 UNTIL 3 DO IF N1[P]≠0 THEN BEGIN
00580	
00590	IF X[P]>0 THEN BEGIN
00600	 S1←S1+(LDB(POINT(9,RES[K-D[P]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],8));
00610	 S2←S2+(LDB(POINT(9,RES[K-D[P]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],17));
00620	 S3←S3+(LDB(POINT(9,RES[K-D[P]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],26));
00630	 S4←S4+(LDB(POINT(9,RES[K-D[P]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],35));
00640	END;
00650	
00660	IF X[P]<(1 LSH N1[P])-1 THEN BEGIN
00670	 S1←S1+(LDB(POINT(9,RES[K+D[P]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],8));
00680	 S2←S2+(LDB(POINT(9,RES[K+D[P]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],17));
00690	 S3←S3+(LDB(POINT(9,RES[K+D[P]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],26));
00700	 S4←S4+(LDB(POINT(9,RES[K+D[P]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],35));
00710	END; END;
00720	
00730	
00740	SUM←S1+S2+S3+S4;
00750	IF SUM≠0 THEN SMOCNT←SMOCNT+1 ELSE BEGIN
00760	
00770	FOR P←0 STEP 1 UNTIL 3 DO IF N1[P]≠0 THEN BEGIN
00780	
00790	
00800	IF X[P]>0 THEN FOR Q←P+1 STEP 1 UNTIL 3 DO IF N1[Q]≠0 THEN BEGIN
00820	
00830	IF X[Q]>0 THEN BEGIN
00840	 S1←S1+(LDB(POINT(9,RES[K-D[P]-D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],8));
00850	 S2←S2+(LDB(POINT(9,RES[K-D[P]-D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],17));
00860	 S3←S3+(LDB(POINT(9,RES[K-D[P]-D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],26));
00870	 S4←S4+(LDB(POINT(9,RES[K-D[P]-D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],35));
00880	 END;
00890	
00900	IF X[Q]<(1 LSH N1[Q])-1  THEN BEGIN
00910	 S1←S1+(LDB(POINT(9,RES[K-D[P]+D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],8));
00920	 S2←S2+(LDB(POINT(9,RES[K-D[P]+D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],17));
00930	 S3←S3+(LDB(POINT(9,RES[K-D[P]+D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],26));
00940	 S4←S4+(LDB(POINT(9,RES[K-D[P]+D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],35));
00950	 END; END;
00960	
00970	IF X[P]>1 THEN BEGIN
00980	 S1←S1+(LDB(POINT(9,RES[K-D[P]*2],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],8));
00990	 S2←S2+(LDB(POINT(9,RES[K-D[P]*2],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],17));
01000	 S3←S3+(LDB(POINT(9,RES[K-D[P]*2],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],26));
01010	 S4←S4+(LDB(POINT(9,RES[K-D[P]*2],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],35));
01020	 END;
01030	
01040	
01050	IF X[P]<(1 LSH N1[P])-1 THEN
01060	 FOR Q←P+1 STEP 1 UNTIL 3 DO IF N1[Q]≠0 THEN BEGIN
01070	
01080	IF X[Q]>0 THEN BEGIN
01090	 S1←S1+(LDB(POINT(9,RES[K+D[P]-D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],8));
01100	 S2←S2+(LDB(POINT(9,RES[K+D[P]-D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],17));
01110	 S3←S3+(LDB(POINT(9,RES[K+D[P]-D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],26));
01120	 S4←S4+(LDB(POINT(9,RES[K+D[P]-D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],35));
01130	 END;
01140	
01150	IF X[Q]<(1 LSH N1[Q])-1  THEN BEGIN
01160	 S1←S1+(LDB(POINT(9,RES[K+D[P]+D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],8));
01170	 S2←S2+(LDB(POINT(9,RES[K+D[P]+D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],17));
01180	 S3←S3+(LDB(POINT(9,RES[K+D[P]+D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],26));
01190	 S4←S4+(LDB(POINT(9,RES[K+D[P]+D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],35));
01200	 END; END;
01210	
01220	IF X[P]<(1 LSH N1[P])-2 THEN BEGIN
01230	 S1←S1+(LDB(POINT(9,RES[K+D[P]*2],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],8));
01240	 S2←S2+(LDB(POINT(9,RES[K+D[P]*2],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],17));
01250	 S3←S3+(LDB(POINT(9,RES[K+D[P]*2],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],26));
01260	 S4←S4+(LDB(POINT(9,RES[K+D[P]*2],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],35));
01270	 END;
01280	
01290	END;
01300	
01310	SUM←S1+S2+S3+S4;
01320	IF SUM≠0 THEN SMCNT2←SMCNT2+1;
01330	END;
01340	
01350	IF SUM=0 THEN BEGIN  ZCNT←ZCNT+1; S1←S2←S3←S4←'200; SUM←'1000; END;
01360	
01370	END "SMOOTH";
01380	
01390	PROCEDURE UPDATE;
01400	BEGIN "UPDATE"
01410	
01420	OUTSTR(CRLF);
01430	CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOF);
01440	LOOKUP(CHAN2,"RES.DAT",RFLAG);
01450	CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,0,10,0,0,0);
01460	ENTER(CHAN3,"RES.NEW",0);
01470	CLOSE(CHAN6); OPEN(CHAN6,"DSK",'10,0,10,0,0,0);
01480	ENTER(CHAN6,"USE.DAT",0);
01490	SETFORMAT(3,0);
01500	
01510	FOR I←0 STEP 1 UNTIL TABNUM DO BEGIN
01520	  IF NAMES[I]=0 THEN DONE;
01530	  J←I*TABSIZ;
01540	  N1[0]←LDB(POINT(3,IN1[I],11));
01550	  N1[1]←LDB(POINT(3,IN2[I],11));
01560	  N1[2]←LDB(POINT(3,IN3[I],11));
01570	  N1[3]←LDB(POINT(3,IN4[I],11));
01580	
01590	  FOR K←0 STEP 1 UNTIL TABSIZ-1 DO RES[K]←0;
01600	  ARRYIN(CHAN2,RES[0],TABSIZ);
01610	
01620	  FOR K←0 STEP 1 UNTIL TABSIZ-1 DO BEGIN
01630	    L←J+K;
01640	
01650	    NEW←LDB(POINT(9,LRN[L],8));
01660	    OLD←LDB(POINT(9,RES[K],8));
01670	    S1←(OLD LSH 5)+NEW;
01680	
01690	    NEW←LDB(POINT(9,LRN[L],17));
01700	    OLD←LDB(POINT(9,RES[K],17));
01710	    S2←(OLD LSH 5)+NEW;
01720	
01730	    NEW←LDB(POINT(9,LRN[L],26));
01740	    OLD←LDB(POINT(9,RES[K],26));
01750	    S3←(OLD LSH 5)+NEW;
01760	
01770	    NEW←LDB(POINT(9,LRN[L],35));
01780	    OLD←LDB(POINT(9,RES[K],35));
01790	    S4←(OLD LSH 5)+NEW;
01800	
01810	    RES[K]←((S1 LSH -5) LSH 27) + ((S2 LSH -5) LSH 18)
01820	      + ((S3 LSH -5) LSH 9) + (S4 LSH -5);
01830	    LRN[L]←LRN[L] LAND '037037037037;
01840	
01850	    SUM←S1+S2+S3+S4;
01860	    IF SUM=0 THEN SMOOTH;
01870	
01880	    S1←(S1 LSH 9)%SUM; S2←(S2 LSH 9)%SUM;
01890	    S3←(S3 LSH 9)%SUM; S4←(S4 LSH 9)%SUM;
01900	    IF S1=512 THEN S1←511 ELSE IF S2=512 THEN S2←511 ELSE
01910	    IF S3=512 THEN S3←511 ELSE IF S4=512 THEN S4←511;
01920	    USE[K]←(S1 LSH 27)+(S2 LSH 18)+(S3 LSH 9) +S4;
01930	    END;
01940	
01950	  ARRYOUT(CHAN3,RES[0],TABSIZ); ARRYOUT(CHAN6,USE[0],TABSIZ);
01960	  OUTSTR("Table "&CVXSTR(NAMES[I])&TB
01970	   &CVS(SMOCNT)&" near-smoothed   "
01980	   &CVS(SMCNT2)&" far-smoothed   "&CVS(ZCNT)&" averaged."&CRLF);
01990	  SMOCNT←smcnt2←ZCNT←0;
02000	  END;
02010	⊂ CLOSE(CHAN2); RENAME(CHAN2,"",0,0); RELEASE(CHAN2);
02020	CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOF);
02030	LOOKUP(CHAN3,"RES.NEW",0);RENAME(CHAN3,"RES.DAT",0,0); RELEASE(CHAN3);
02040	 CLOSE(CHAN6);
02050	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,EOF);
02060	ENTER(CHAN1,"LRN.DAT",0);
02070	ARRYOUT(CHAN1,LRN[0],TABTOT); CLOSE(CHAN1);
02080	OUTSTR("Update completed."&CRLF);
02090	END "UPDATE";
02100	
     

00010	STDBRK(1);
00020	SETBREAK(14,"∃",NULL,"INS");
00030	
00040	FILEL←"LIST28";
00050	FILEI←"TOO1.DAT[1,THO]";
00060	CHAN1←1; CHAN2←2; CHAN3←3;  CHAN4←4; CHAN5←5; CHAN6←6;
00070	HEADIN;
00080	FOR I←0 STEP 1 UNTIL 15 DO IF NAMES[I]=0 THEN DONE; TABTOT←I*TABSIZ;
00090	OUTSTR("TABTOT= "&CVS(TABTOT)&CRLF);
00100	FLAG←0; SIG(P); FLAG←-1;  ⊂ To preset addrssses in SIG;
00110	CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00120	LOOKUP(CHAN1,"LRN.DAT",0);ARRYIN(CHAN1,LRN[0],TABTOT);CLOSE(CHAN1);
00130	RELEASE(CHAN1);
00140	FILEL←STRIN("Data file list (LIST28) = ");
00150	IF FILEL="" THEN FILEL←"LIST28";
00160	CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFA);
00170	LOOKUP(CHAN5,FILEL,ER);
00180	WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&" File = ");
00190	LOOKUP(CHAN5,FILEL←INCHWL,ER); END;  EOFA←0;
00200	FILLST←INPUT(CHAN5,14); EOFA←0; RL←0;
00210	WHILE EOFA=0 DO BEGIN "LISTREAD"
00220	HINDEX←21; HCOUNT←HINCNT←0;
00230	FILEI←SCAN(FILLST,1,J); IF FILEI="" THEN DONE;
00240	
00250	CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00260	LOOKUP(CHAN4,FILEI,ER);
00265	 IF EOF≠0 THEN DONE;
00270	ARRYIN(CHAN4,LFILE[0],'200);	⊂ Input header;
00280	SEGTOT←(LFILE[0]*6)%256;
00290	OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
00300	ARRYIN(CHAN4,INDATA[0],SEGTOT*4); CLOSE(CHAN4);
00310	BPT←POINT(6,INDATA[0],-1); HINDEX←21; HCOUNT←HINCNT←0;
00320	
00330	FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
00340	  READ1←HEADER;
00350	  J←CVSIX(READ1);
00360	  FOR I←0 STEP 1 UNTIL 63 DO BEGIN   IF PHLIST[I]=0 THEN BEGIN
00370	    OUTSTR("Hint not identified for segment = "&READ1
00380	        &"   " &CVS(SEGC)&CRLF);DONE END;
00390	    IF PHLIST[I]=J THEN BEGIN HINT←HLIST[I]; PHW←J; DONE ; END;
00400	    END;
00410	
00420	FOR P←0 STEP 1 UNTIL 23 DO  INDAT[P]←ILDB(BPT);
00430	  IF PHW≠CVSIX("NU") THEN SIG(P);
00440		END;
00450	
00460	OUTSTR(CVS(HINCNT)&" hints . ");
00470	IF RL=0 THEN RL←1 ELSE BEGIN RL←0; OUTSTR(CRLF); END;
00480	UPDATE;
00490	IF EOFA≠0 THEN DONE;
00500	END "LISTREAD";
00510	RELEASE(CHAN1); RELEASE(CHAN2); RELEASE(CHAN3); RELEASE(CHAN6);
00520	
00530	OUTSTR("Tables saved"&CRLF);
00540	END "SAY";